home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 3
/
Cream of the Crop 3.iso
/
comm
/
prtcs155.zip
/
SHELTER.REX
< prev
next >
Wrap
OS/2 REXX Batch file
|
1994-01-14
|
36KB
|
1,142 lines
/* Shelter WPL Mailers Manager Williamson */
/* OPTIONS */
do_outs=0 /* if 1, flocvt will queue .OUT files */
/**/
options results
options failat 99
signal on syntax
signal on halt
signal on ioerr
signal on break_c
signal on break_d
if ~show('L', "rexxsupport.library") then
if ~addlib("rexxsupport.library", 0, -30, 0) then do
say "Couldn't access rexxsupport.library !"
exit 20
end
if ~show('L', "RexxDosSupport.library") then
if ~addlib("RexxDosSupport.library", 2, -30, 0) then do
say "Couldn't access RexxDosSupport.library !"
exit 20
end
if ~show('L', "hGRexxSupport.library") then
if ~addlib("hGRexxSupport.library", 2, -30, 0) then do
say "Couldn't access hGRexxSupport.library !"
exit 20
end
if (left(ReadVar('KickStart',"R"),2)) < 37 then do
say 'Sorry, AmigaDOS Release 2 or higher is required to use Shelter'
exit 20
end
if ~show("L", "xferq.library") then
if ~addlib("xferq.library", 0, -30, 0) then do
say "Couldn't access xferq.library !"
exit 20
end
pragma("W","NULL")
Address COMMAND "CD MAIL:"
if RC~=0 then do
say 'Where is MAIL:?'
exit 40
end
wpath='CFG:WPL/'
log=show('P',"ROOFLOG")
wfhost=ReadVar('WFHOST')=="TRUE"
pktpri=55
CLS='0C'x; CSI='9b'x;OFF=CSI||'0m';BOLD=CSI||'1m';ULINE=CSI||'4m';ITALICS=CSI||'3;40m'
/* get Shelter Mailer Name */
smver=ReadVar('SMVER',"R")
shelter=ReadVar("SHELTER","R")
if shelter="" | shelter = "SHELTER" then do
Say "No Shelter Mailer available"
u_shelter="*** NO SHELTER ***"
signal usage
end
call setup(shelter)
XQ_NOTHING=0;XQ_DELETE=1;XQ_TRUNCATE=2;XQ_IMMEDIATE=4;XQ_SENDLATER=8
DTPRI_HXT=60;DTPRI_CRASH=50;DTPRI_DIRECT=30;DTPRI_NORM=0;DTPRI_HOLD=-50
fontsize=8;havewin=0;DoUnLoad=0
PARSE UPPER ARG WHAT WHERE HOW
if WHAT="" | WHAT="?" then signal usage
Select
when WHAT="INIT" then do
call GetVariables
end
when WHAT="CALL" then do
if WHERE="" then signal callusage
call dial(WHERE,HOW)
end
when WHAT="RESTART" then do
call openwin("P")
call closemailer(WHAT)
call closelogs
options prompt "Generate? (y/N) "
parse pull ans
if upper(ans)="Y" then do
Address REXX GetClip('REXXDIR')'/GenMailer.rexx' u_shelter 'ALL'
if RC~=0 then exit RC
end
call GetVariables()
if ~DoUnLoad then call raisemailer()
say "Command: "what" completed"
end
when what="AUTO" then do
call GetVariables()
call openpscr()
call openwin("P")
call loadlogproc()
call raisemailer()
call flocvt
boss_site=GetClip("BOSS")
parse var boss_site System number
call dial(System,number,"S")
if u_shelter="UMBRELLA" then do
call closemailer(WHAT)
call closelogs
call closepscr
end
end
when what="AUTOX" then do
call GetVariables()
call openpscr()
call openwin("P")
call loadlogproc()
call raisemailer()
boss_site=GetClip("BOSS")
parse var boss_site System number
call dial(System,number,"S")
if u_shelter="UMBRELLA" then do
call closemailer(WHAT)
call closelogs
call closepscr
end
end
when WHAT="KILL" then do
if WHERE="" then signal callusage
call openwin("S")
call killdial(WHERE)
end
when WHAT="OPENSTATUS" then call openstatus(WHERE)
when WHAT="CLOSESTATUS" then call closestatus(WHERE)
when WHAT="EXIT" then do
call openwin("S")
call closemailer(WHAT)
call closelogs
call closepscr
end
when WHAT="FLOCVT" then do
call openwin("S")
call flocvt()
say "Command: "what" completed"
end
when WHAT="ADDWORK" then do
call openwin("P")
call addwork(WHERE,HOW)
say "Command: "what" completed"
end
when WHAT="POLL" then do
call openwin("S")
call dopolls(WHERE)
say "Command: "what" completed"
end
when WHAT="CLEAN" then do
call openwin("P")
call cleanxq()
say "Command: "what" completed"
end
when WHAT="START" then do
if WHERE ~="" & WHERE ~="WHERE" then call setup(WHERE)
call GetVariables()
call openpscr()
call openwin("P")
call loadlogproc()
call raisemailer()
call addwork("BADPASSWORD","CFG:PASSWORD.BAD L 75")
if exists(rexxdir||'Sctl.rexx') then address AREXX rexxdir||'Sctl.rexx'
say "Command: "what" completed"
end
otherwise Say 'Unknown command:'what
end /*select*/
/*
if havewin=1 then do
call close('STDIN')
call close('STDOUT')
end
*/
exit 0
loadlogproc:
if ~showlist('p','LOGPROC') then do
Address COMMAND "run >nil: logproc"
say "Waiting for LogProc Port"
Address COMMAND "waitforport LOGPROC"
say "Log port ready"
end
if ~showlist('p','LOGPROC') then do
say "Unabled to access LOGPROC"
exit 10
end
return
raisemailer:
logfile=GetClip('LOGFILE')
if logfile="" then logfile="MAIL:Shelter.LOG"
Say "Opening "logfile
Address "LOGPROC"
'OpenLog' file 'f' logfile
logwindow=GetClip('LOGWINDOW')
if index(logwindow,":")=0 then 'AddLogGroup' fgroup file
else do
logwindow=logwindow||"/SCREEN"||GetClip('SCREEN')
Say "Opening "logwindow
'OpenLog' fwindow 'w' logwindow
'AddLogGroup' fgroup file fwindow
end
Address
slave=0
PutLog('Opened log 'logfile date())
slave=1
if show('P',mport||slave) then do
say mport||slave 'already active'
exit 10
end
if ~show('p',"sushi_CAS_port") then do
PutLog('Loading Sushi')
address COMMAND "Run Sushi <>NULL: ON NOPROMPT ASKSAVE"
call SetCLip('MYSUSHI',"TRUE")
end
PutLog('Loading 'u_shelter' Mailer')
pcmd="ChangeTaskPri 1"||'0a'x
scmd="Stack 50000"||'0a'x
do i=1 to wscount
parse var wsrc.i wscript.i '.' x
lcmd='LoadScript' lower(wscript.i) wpath||wsrc.i
cmd=scmd||pcmd||lcmd
address COMMAND cmd
stat=RC
if stat ~=0 then do
PutLog(lcmd 'returned' stat', did you note the error or forget to generate the Mailer?')
DoUnLoad=1;signal unloadscripts
exit
end
end
PutLog('Launching 'u_shelter'0')
cmd=scmd||pcmd||'Launch 'u_shelter'0 'l_shelter'!startup 0 30000'
address COMMAND cmd
stat=RC
if stat ~=0 then PutLog(cmd 'returned' stat)
return 0
closemailer:
call putlog('Closing slaves')
if u_shelter~="UMBRELLA" then ports=GetClip('SLAVES')
else ports=1
do i=ports to 1 by -1
if show('p',mport||i) then do
call PutLog('Closing:'mport||i)
address VALUE mport||i
'Set exit 'arg(1)
call delay(10)
'ABORT'
do while show('p',mport||i)
call delay(10)
end
end
call delay(100)
end
unloadscripts:
call putlog('Flushing mailer')
do i=1 to wscount
parse var wsrc.i wscript.i '.' x
ulcmd='LoadScript' lower(wscript.i) '""'
address COMMAND ulcmd
stat=RC
if stat~=0 then call PutLog(ulcmd 'returned' stat)
call closestatus(i)
end
if show('P','sushi_CAS_port') then do
if GetCLip('MYSUSHI')="TRUE" then do
call PutLog("Closing Sushi")
address COMMAND "sushi OFF"
end
end
return 0
closelogs:
call putlog('Closing logs')
address "LOGPROC"
'Closelog 'file
logwindow=GetClip('LOGWINDOW')
if index(logwindow,":") > 0 then 'CloseLog' fwindow
'RemLogGroup 'fgroup
return
closestatus:
slave=arg(1)
if u_shelter="UMBRELLA" then slave=1
address "LOGPROC"
'Closelog 'window||slave
'RemLogGroup' wgroup||slave
Address
return 0
openstatus:
if u_shelter="UMBRELLA" then slave=1
else slave=arg(1)
if ~show('P',mport||slave) then do
PutLog(mport||slave 'not active')
exit 10
end
rws.specs=GetClip('WSPEC')
if rws.specs="" then rws.specs="NOSIZE/NODEPTH/INACTIVE"
rws.x=0 ; rws.y=10 ; rws.chars=80 ; rws.lines=7 ; rws.text='@f3@R'
rws.0=' Status'copies(" ",53)'H_Freqs'copies(" ",10)
rws.1=' Response'copies(" ",13)'Login'copies(" ",35)'R_Freqs'copies(" ",10)
rws.2=' Baud'copies(" ",13)'H_Adr'copies(" ",35)'Inbound'copies(" ",10)
rws.3=' Number'copies(" ",13)'R_Adr'copies(" ",35)'Domain'copies(" ",10)
rws.4=' Password'copies(" ",13)'Sysop'copies(" ",52)
rws.5=' Session'copies(" ",13)'H_Ofr'copies(" ",52)
rws.6=' Protocol'copies(" ",13)'R_Ofr'copies(" ",52)
p.1="p.status @1,10,53 @R"
p.2="p.response @2,10,13 @R"
p.3="p.baud @3,10,13 @R"
p.4="p.number @4,10,13 @R"
p.5="p.password @5,10,13 @R"
p.6="p.session @6,10,13 @R"
p.7="p.protocol @7,10,13 @R"
p.8="p.login @2,28,35 @R"
p.9="p.host @3,28,35 @R"
p.10="p.remote @4,28,35 @R"
p.11="p.rsysop @5,28,52 @R"
p.12="p.hoffer @6,28,52 @R"
p.13="p.roffer @7,28,52 @R"
p.14="p.hfreqs @1,70,10 @R"
p.15="p.rfreqs @2,70,10 @R"
p.16="p.inbound @3,70,10 @R"
p.17="p.domain @4,70,10 @R"
positions=17
if u_shelter~="UMBRELLA" then do
slavewindows=getwindows()
if slavewindows~=0 then rws.y=rws.y+(w_height(rws.lines)*slavewindows)
end
Address VALUE mport||slave
'String $(device) $(unit) $(modem)'
minfo=mport||slave strip(RESULT)
xspec='RAW:'rws.x'/'rws.y'/'w_width(rws.chars)'/'w_height(rws.lines)'/The 'u_shelter' Mailer v'smver' 'minfo'/'rws.specs'/SCREEN'GetClip('SCREEN')
address "LOGPROC"
'OpenLog' window||slave "'w'" xspec
'AddLogGroup' wgroup||slave window||slave
do i=0 to rws.lines
'PutLine' wgroup||slave '@'i+1',1' rws.text||rws.i||copies(" ",rws.chars-length(rws.i))
end
Address VALUE mport||slave
do i=1 to positions
'Set' word(p.i,1) '"'subword(p.i,2)'"'
end
Address
return 0
getwindows: procedure expose l_shelter
slavewindows=0
Address LOGPROC 'Show "l"'
logs=RESULT
if words(logs)=0 & slave > 1 then return slave-1
if words(logs)=0 then return 0
do i=1 to words(logs)
if index(word(logs,i),l_shelter'ss') > 0 then slavewindows=slavewindows+1
end
return slavewindows
dial:
System=arg(1)
Number=arg(2)
lmode=arg(3)
if Number="NUMBER" then Number=""
else number="NUMBER "Number
if u_shelter="ROOF" then address COMMAND "RUN >NIL: CALL" System Number
else do
if lmode="S" then Address "REXX" GetClip('REXXDIR')"/Scall" System Number
else Address "AREXX" GetClip('REXXDIR')"/Scall" System Number
end
return
killdial:
if ~datatype(arg(1),'MIXED') then site_address=make5d(arg(1))
else site_address=arg(1)
call SetClip("S"||site_address,'abort')
PutLog('Call to 'site_address' will be aborted on next attempt')
return
callcleanup:
call PutLog('Removing 'site_address' from dial queue')
call SetClip("S"||site_address,"")
return 0
make5d: procedure expose dd z n f p
da=arg(1)
select
when index(da, "#") > 0 then parse var da dd "#" z ":" n "/" f "." p
when index(da, ":") > 0 then parse var da z ":" n "/" f "." p
when index(da, "/") > 0 then parse var da n "/" f "." p
when index(da, ".") > 0 then parse var da f "." p
when left(da, 1)="." then parse var da "." p
otherwise parse var da f .
end
myaddress.domain=GetClip('DOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
if p="" | p='P' then p='0'
if n="" | n='N' then n=myaddress.net
if f="" | f='F' then f=myaddress.node
if z="" | z='Z' then z=myaddress.zone
if dd="" | dd='DD' then do
dl=GetClip('DOMAINLIST')
dd=0
x=find(dl,z)
if x~=0 then dd=word(dl,x-1)
if dd=0 then dd=myaddress.domain
end
if ~datatype(z,'n') | ~datatype(n,'n') | ~datatype(f,'n') | ~datatype(p,'n') then do
call PutLog('make5d: Invalid address ['da']')
return 0
end
drop da
if myaddress.domain"#"cfgaddress=dd'#'z':'n'/'f'.'p
then p=0
return(dd'#'z':'n'/'f'.'p)
flocvt:
outdir=addslash(dequote(GetClip('OUTDIR')))
flodir=addslash(dequote(GetClip('FLODIR')))
call PutLog('Searching for FLO files in' flodir)
Address COMMAND 'LIST >t:flofilelist 'flodir||'#?.#?.#?.#?.?LO quick nohead'
if word(statef("T:flofilelist"),2)=0 then do
call PutLog('No ?LO files in' outdir)
Signal scanout
end
if ~open('flolist',"t:flofilelist",'R') then do
call PutLog("Error opening 4D .FLO list")
return 10
end
i=0
do forever
Line=Upper(strip(space(ReadLn('flolist'),1),'B'))
if EOF('flolist') then Leave
if Line="" then iterate
i=i+1
node.i=Line
parse var Line flonode.i.zone "." flonode.i.net "." flonode.i.node "." flonode.i.point "." junk
flonode.i.domain=find_domain(flonode.i.zone)
flonode.i.pri="0"
floadr=flonode.i.zone":"flonode.i.net"/"flonode.i.node"."flonode.i.point
if Left(junk,1)="C" then flonode.i.pri=DTPRI_CRASH
if Left(junk,1)="H" then flonode.i.pri=DTPRI_HOLD
if Left(junk,1)="D" then flonode.i.pri=DTPRI_DIRECT
if Left(junk,1)="N" then flonode.i.pri=DTPRI_NORM
if Left(junk,1)="F" then flonode.i.pri=DTPRI_NORM
end
call close('flolist')
if i=0 then do
call PutLog("Error: No 4D ?LO Files found in" flodir)
drop flonode floadr
call delete("T:flofilelist")
return 0
end
flonode.numnodes=i
do anode=1 until anode=flonode.numnodes
drop flags
floadr=flonode.anode.zone':'flonode.anode.net'/'flonode.anode.node'.'flonode.anode.point
call PutLog("Converting" node.anode "for" floadr)
jnode=left(node.anode,length(node.anode)-3)
floname=upper(flodir||jnode||Left(right(node.anode,3),1)||"LO")
call PutLog("floname:"floname)
flonode.anode.domain=find_domain(flonode.anode.zone)
site=flonode.anode.domain||"#"||flonode.anode.zone||":" ,
||flonode.anode.net||"/"||flonode.anode.node||"."||flonode.anode.point
PutLog('Site:'site,10,10)
if u_shelter="ROOF" then myaddress.domain=GetClip('DOMAIN')
else myaddress.domain=GetClip('FTNDOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
err=0
if ~exists(floname) then do
call PutLog("Error: Can't find "floname)
call drop_vars
err=1
end
else if ~Open('flofile',floname,'R') then do
call PutLog("Error: Can't open" floname)
call drop_vars
err=1
end
site_address=XfqGetAddress(site)
if ~err then do
do forever
Line=upper(ReadLn('flofile'))
if eof('flofile') then Leave
if Line="" then Iterate
flags=XQ_NOTHING
if (LEFT(Line,1)="#") then do
flags=XQ_TRUNCATE
Line=DELSTR(Line,1,1)
end;else if (LEFT(Line,1)="^") | (LEFT(Line,1)="-") then do
flags=XQ_DELETE
Line=DELSTR(Line,1,1)
end;else if (LEFT(Line,1)="@") then do
flags=XQ_NOTHING
Line=DELSTR(Line,1,1)
end
if ~exists(Line) then do
call PutLog("File "Line" No Longer Exists")
Iterate
end
if right(Line,4) = ".TIC" then do
flags=XQ_DELETE
sendas=get_fn(Line)
end;else if right(Line,2)="UT" then do
Line=move_out(Line)
sendas=get_packetname()
if Left(right(Line,3),1)="C" then t.pri=DTPRI_HXT
if Left(right(Line,3),1)="H" then t.pri=DTPRI_HOLD
if Left(right(Line,3),1)="D" then t.pri=DTPRI_DIRECT
if Left(right(Line,3),1)="N" then t.pri=DTPRI_NORM
if Left(right(Line,3),1)="F" then t.pri=flonode.anode.pri
end;else do
parse var Line x '.' x '.' x '.' x '.' ext
if ext="" then do
sendas=get_fn(Line)
flags=XQ_NOTHING
t.pri=flonode.anode.pri
end;else do
tmpext=upper(left(ext,2))
if datatype(right(ext,1),'n') & (tmpext="MO" | tmpext="TU" | tmpext="WE" | tmpext="TH" | tmpext="FR" | tmpext="SA" | tmpext="SU") then do
sendas=UPPER(d2x(65536+myaddress.net-flonode.anode.net,4)||d2x(65536+myaddress.node-flonode.anode.node,4)||'.'ext)
flags=XQ_DELETE
t.pri=flonode.anode.pri
end
end
drop ext x
end
call PutLog(Line' as 'sendas' for:'floadr' Disp:'flags' Pri:'t.pri)
QUERY.XQ_NAME=line
QUERY.XQ_SITE=site_address
work=NULL
work=XfqFindWork(QUERY)
if work=NULL then do
call PutLog("File "line" not in "site" queue, adding as "sendas)
XfqAddWorkQuick(site,Line,sendas,t.pri,flags)
end;else do
call PutLog("File "line" re-queued")
call XfqUnlockWork(work)
/* call XfqDropObject(work) */
end
end /*forever*/
end /* flofile */
call close('flofile')
call delete(floname)
call XfqFlushQueue(site_address)
call XfqDropObject(site_address)
if work~=NULL then call XfqDropObject(work)
end
call XfqClose()
call drop_vars
call delete("T:flofilelist")
scanout:
call PutLog('Searching for .?UT files in' outdir)
Address COMMAND 'LIST >t:outlist 'outdir||'#?.#?.#?.#?.?UT quick nohead'
if word(statef("T:outlist"),2)=0 then do
call PutLog('No ?UT files in' outdir)
Return
end
if ~open('outs',"t:outlist",'R') then do
call PutLog("Error opening 4D .?UT list")
return 10
end
do while ~eof('outs')
outfile=upper(readln('outs'))
if outfile="" then iterate
parse var outfile oz '.' on '.' of '.' op '.' ext
if ~do_outs & ext="OUT" then do
PutLog('Skipping 'outfile)
Iterate
end
xtype=left(ext,1)
if xtype="C" then flonode.i.pri=DTPRI_HXT
else if xtype="H" then flonode.i.pri=DTPRI_HOLD
else if xtype="D" then flonode.i.pri=DTPRI_DIRECT
else if xtype="N" then flonode.i.pri=DTPRI_NORM
else if xtype="O" then flonode.i.pri=DTPRI_NORM
else do
call PutLog('ERROR: cannot queue 'outfile)
Iterate
end
drop xtype
call addwork(oz':'on'/'of'.'op,outdir||outfile "D" flonode.i.pri)
end
call delete("T:outlist")
return
move_out:
call makedir(outdir||"PKT")
newline=outdir||"PKT/"get_fn(arg(1))
Address COMMAND 'Copy 'arg(1) newline
call delete(arg(1))
return newline
addwork:
site_address=arg(1)
qaz=space(arg(2),1)
parse var qaz file disposition priority .
PutLog('Addwork:'site_address file disposition priority)
if ~datatype(site_address,"MIXED") then do
isftn=1;site_address=make5d(site_address)
end;else do
isftn=0;site=site_address
end
if site_address=0 then return
if file="" | ~(exists(file)) then do
PutLog('Cannot find ['file']')
return 1
end
file=upper(file)
select
when disposition="D" then flags=XQ_DELETE
when disposition="T" then flags=XQ_TRUNCATE
when disposition="L" then flags=XQ_NOTHING
otherwise flags=XQ_NOTHING
end
if datatype(priority,"MIXED") then do
priority=value("DTPRI_"priority)
prispec=1
end;else do
prispec=0
select
when priority > 50 then nop
when priority > 30 then priority=DTPRI_CRASH
when priority > 0 then priority=DTPRI_DIRECT
when priority=0 then priority=DTPRI_NORM
when priority=-50 then priority=DTPRI_HOLD
otherwise priority=DTPRI_CRASH
end
end
if ~isftn then sendas=get_fn(file)
else do
if right(file,4)=".CUT" | right(file,4)=".DUT" | right(file,4)=".HUT" | right(file,4)=".OUT" then do
sendas=get_packetname()
flags=XQ_DELETE
end
else if right(file,4)=".PKT" then do
sendas=get_fn(file)
flags=XQ_DELETE
if ~prispec then priority=DTPRI_HXT
end
else if right(file,4)=".TIC" then do
sendas=get_fn(file)
flags=XQ_DELETE
end;else do
parse var file td'.'tz'.'tn'.'tf'.'tp'.'ext .
if ext ~= "" then call addarcmail
else do
parse var file tz'.'tn'.'tf'.'tp'.'ext .
if ext ~= "" then call addarcmail
else sendas=get_fn(file)
end
drop td tz tn tf tp ext tmpext j
end
dd=find_domain(z)
site=dd||"#"||z||":"||n||"/"||f||"."||p
end
site_address=XfqGetAddress(site)
QUERY.XQ_NAME=file
QUERY.XQ_SITE=site_address
work=NULL
work=XfqFindWork(QUERY)
if work=NULL then do
PutLog("File "file" not in site queue, adding")
XfqAddWorkQuick(site,file,sendas,priority,flags)
end;else do
PutLog("File "file" already queued")
if work ~=NULL then call XfqUnlockWork(work)
end
/*call XfqDropObject(work) */
call XfqFlushQueue(site_address)
call XfqDropObject(site_address)
if work ~=NULL then do
if isftn then call PutLog('Queued 'file' as 'sendas' for 'dd'#'z':'n'/'f'.'p' Pri:'priority 'Dsp:'flags)
else call PutLog('Queued 'file' as 'sendas' for 'site' Pri:'priority 'Dsp:'flags)
end
call XfqClose()
return
addarcmail:
if u_shelter="ROOF" then myaddress.domain=GetClip('DOMAIN')
else myaddress.domain=GetClip('FTNDOMAIN')
cfgaddress=GetClip('HOST.ADDRESS.'||myaddress.domain)
parse var cfgaddress myaddress.zone ":" myaddress.net "/" myaddress.node "." myaddress.point
tmpext=upper(left(ext,2))
if datatype(right(ext,1),'n') & (tmpext="MO" | tmpext="TU" | tmpext="WE" | tmpext="TH" | tmpext="FR" | tmpext="SA" | tmpext="SU") then do
sendas=UPPER(d2x(65536+myaddress.net-tn,4)||d2x(65536+myaddress.node-tf,4)||'.'ext)
flags=XQ_DELETE
return 1
end
return 0
dopolls:
minpri=arg(1)
if minpri="" | minpri='MINPRI' then minpri=0
else do
minpri=value("DTPRI_"minpri)-1
PutLog('Polling only Priority >'minpri)
end
call PutLog('Scheduling Polls')
sitelist=XfqGetSiteList()
call XfqWalkSession(sitelist,sitearray)
if sitearray.numentries=1 then call PutLog("There is 1 site in the queue")
else call PutLog("There are "sitearray.numentries" sites in the queue")
do loop = 1 to sitearray.numentries
MaxPri=XfqMaxSitePri(sitearray.loop)
addrtags.XQ_Mandatory=511
addrtags.XQ_Optional=511
System = upper(XfqPutAddress(sitearray.loop,addrtags))
if System="BADPASSWORD" then Iterate
PutLog("Site:"System" Pri:"MaxPri)
if (MaxPri<-1)|(MaxPri>120) then Iterate
if System="BADADDRESS" then iterate
if System~="" then do
if MaxPri>MinPri then do
call PutLog('Calling:' System)
call dial(System)
end;else do
call PutLog('Not calling: 'System' Pri:'MaxPri)
end
end
end
call XfqDropObject(sitelist)
call XfqClose()
return 0
cleanxq:
sitelist=XfqGetSiteList()
call XfqWalkSession(sitelist,sitearray)
call PutLog("There are "sitearray.numentries" sites in the queue")
do loop = 1 to sitearray.numentries
addrtags.XQ_Mandatory = 511 /* XQADDR_ANYTHING */
addrtags.XQ_Optional = 511 /* XQADDR_ANYTHING */
System = XfqPutAddress(sitearray.loop,addrtags)
call XfqWalkQueue(sitearray.loop,thestem)
call PutLog("There are "thestem.NUMENTRIES" files for "System)
do i=1 to thestem.NUMENTRIES
call PutLog("Sending "thestem.i.NAME" as "thestem.i.ASNAME" at priority "thestem.i.PRI)
if ~EXISTS(thestem.i.NAME) then do
call PutLog("File "thestem.i.NAME" does not exist")
FINDIT.XQ_NAME = thestem.i.NAME
FINDIT.XQ_SITE = sitearray.loop
work = XfqFindWork(FINDIT)
if(work=NULL) then call PutLog("Someone got to it before us!")
else do
call XfqRemoveWork(work)
/* call XfqDropObject(work) */
end
end
end
end
call XfqDropObject(sitelist)
call XfqClose()
return thestem.NUMENTRIES
getakey:
options PROMPT "Hit a key"
parse pull junk
return
get_packetname:
pktspec="CFG:packet_spec"
if ~open('out',pktspec,'R') then call PutLog("Can't read "pktspec)
else do
packet_spec=readln('out')
call close('out')
drop out
end
tspec=left(date(),2)||compress(time(),":")
if (tspec=packet_spec) then tspec=tspec+1
do while exists(outdir||""||tspec".PKT")
tspec=tspec+1
end
if ~open('out',pktspec,'W') then call PutLog("Can't write new "pktspec)
else do
call writeln('out',tspec)
call close('out')
drop out
end
return(tspec||".PKT")
get_fn: procedure
if LastPos('/', arg(1)) ~=0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
else if LastPos(':', arg(1)) ~=0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
else return arg(1)
find_domain: procedure
dl=GetClip('DOMAINLIST')
dz=FIND(dl,arg(1))
if dz=0 then return GetClip('DOMAIN')
else return strip(word(dl,dz-1))
drop_vars:
drop tonode. flonode. hisaddress. work err line
drop floadr site site_address i file pktname floname sendas flags disposition priority
return 0
GetVariables: procedure expose envpath u_shelter
/* copy ENV variables to Clips */
say "Loading environment"
mv.1="SCREEN 1"
mv.2="LOGFILE 0"
if u_shelter="ROOF" then mv.3="DOMAIN 1"
else mv.3="FTNDOMAIN 1"
mv.4="DOMAINLIST 1"
mv.5="INDIR 1"
mv.6="OUTDIR 1"
mv.7="XFERQ 1"
mv.8="REXXDIR 1"
mv.9="REDIALDELAY 1"
mv.10="BUSYDELAY 1"
mv.11="IGNORENOANSWER 1"
mv.12="CALLWINDOWMIN 1"
mv.13="DOMAINAWARE 1"
mv.14="WSPEC 1"
mv.15="WPOS 0"
mv.16="SSPEC 0"
mv.17="SPOS 0"
mv.18="BOSS 0"
mv.19="LOGWINDOW 0"
mv.20="POLLWIN 1"
mv.21="XPRWIN 0"
mv.22="FLODIR 1"
numclips=22
if (u_shelter="ROOF" | u_shelter="PORTICUS") then do
mv.23="MENUS 1"
mv.24="SYSOPBASE 1"
mv.25="FREQDIR 0"
numclips=25
end
do i=1 to numclips
if ~SetClip(upper(word(mv.i,1)),ReadVar(word(mv.i,1))) then do
if strip(word(mv.i,2))=0 then say "Warning: Variable "word(mv.i,1)" is not set"
else do
say "Error: Variable "word(mv.i,1)" is not set "envpath GetVar(envpath||word(mv.i,1),"G")
exit 10
end
end
end
call SetClip('DOMAIN',GetClip('FTNDOMAIN'))
liblist.1="rexxsupport.library"
liblist.2="OwnDevUnit.library"
liblist.3="XferQ.library"
liblist.4="xprzedzap.library"
liblist.5="xprfts.library"
liblist.6="wpl.library"
liblist.7="wplemsi.library"
liblist.8="RexxDosSupport.library"
reqdlibs=8
say "Checking for required libraries"
do i=1 to reqdlibs
parse var liblist.i libname level .
if ~exists('LIBS:'||libname) then do
say 'Missing required library LIBS:'libname', please investigate'
exit 20
end
end
/* Directories to create*/
dir.1=GetClip('INDIR')
dir.2=GetClip('OUTDIR')
dir.3=GetClip('FREQDIR')
dir.4=GetClip('FLODIR')
dir.5=GetClip('INDIR')||"/NONSECURE"
dir.6=GetClip('INDIR')||"/RESUME"
dir.7=GetClip('INDIR')||"/FTNSORT"
dir.8=GetClip('XFERQ')
dirs=8
if u_shelter="ROOF" | u_shelter="PORTICUS" then do
dir.9=GetClip('INDIR')||"/USERS"
dir.10="LOG:rfsacct"
dir.11="LOG:rfsacct/h"
dir.12="LOG:/FREQIT"
dir.13="CFG:/FREQIT"
dirs=13
end
say "Checking for required directories"
do i=1 to dirs
call makedir(dir.i)
end
address COMMAND 'Assign XFERQ:' GetClip('XFERQ')
domain=GetClip('DOMAIN')
Address COMMAND "Echo >XFERQ:hostaddr" domain"#"GetClip('HOST.ADDRESS.'domain)
singleinbound=GetClip('DOMAINAWARE')=="TRUE"
dl=GetClip('DOMAINLIST')
indir=GetClip('INDIR')
outdir=GetClip('OUTDIR')
do ftn=1 to words(dl)-1 by 2
if ~singleinbound then do
call makedir(indir||'/'||word(dl,ftn))
call makedir(outdir||'/'||word(dl,ftn))
end
vname="HOST.ADDRESS."||upper(word(dl,ftn))
if ~SetClip(vname,ReadVar(vname)) then do
say "Error: Variable "vname" is not set"
exit 10
end
end
if u_shelter="PORTICUS" then Address REXX GetClip('REXXDIR')"/PRODCFG DO"
return
ReadVar: procedure expose ENVPATH
if arg(2)="R" then x=GetVar(arg(1),"G")
else x=GetVar(envpath||arg(1),"G")
return x
lower:
return(bitor(arg(1),'20'x))
PutLog: procedure expose fgroup u_shelter slave log havewin
if havewin=1 then say arg(1)
if slave="SLAVE" then slave="MGR"
if log=1 then address 'ROOFLOG' 'logline' left(time(),5) 'SMM: 'arg(1)
address 'LOGPROC' 'PutLog 'fgroup time() u_shelter||slave': 'arg(1)
return 0
w_height: procedure expose fontsize
BAR=13 /* TOP BORDER + BOTTOM BORDER */
if fontsize="" then fontheight=8
else fontheight=fontsize
return ((arg(1)*fontheight)+BAR)
w_width: procedure expose fontsize
BORDER=10 /* LEFT BORDER + RIGHT BORDER */
if fontsize="" then fontwidth=8
else fontwidth=fontsize
return ((arg(1)*fontwidth)+BORDER)
addslash:
curr=arg(1)
select
when right(curr, 1)=":" then nop
when right(curr, 1)="/" then nop /* TackOn */
otherwise curr=curr"/"
end
return curr
/* a useful procedure by Walt Sullivan */
dequote: procedure
parse arg thing
parse var thing '"' unq_thing '"'
if unq_thing ~="" then return unq_thing
return thing
break_c:
break_d:
call callcleanup()
PutLog('User Aborted 'what where)
exit 0
novalue:
call template_oops "Novalue" sigl
syntax:
call template_oops "Syntax(RC=" || RC || ")" sigl RC
failure:
call template_oops "Failure(RC=" || RC || ")" sigl
ioerr:
call template_oops "IOErr(RC=" || RC || ")" sigl
halt:
call template_oops "Halt" sigl
template_oops:
parse arg what badline code
if code~="" then call PutLog("ERROR LINE:"badline errortext(code))
else call PutLog("ERROR LINE:"badline what)
cleanup:
call XfqClose()
exit(40)
/**/
usage:
say CLS
if shelter="" then do
Say "No Shelter Mailer available"
u_shelter="*** NO SHELTER ***"
end
say BOLD||u_shelter" Mailer Manager"||OFF" v"smver
say ITALICS" Usage: Shelter <command> <options>"OFF
say BOLD" START"OFF" - load mailer"
say BOLD" EXIT"OFF" - unload mailer"
say BOLD" RESTART"OFF" - unload, compile and reload mailer"
if u_shelter="UMBRELLA" then say BOLD" AUTO"OFF" - load,convert,call Boss and exit"
else say BOLD" AUTO"OFF" - load, convert and call Hub"
say
say BOLD" ADDWORK"OFF" site fullfilename (disposition) (priority)"
say " - add a file to a site queue"
SAY " disposition:"
SAY " D=delete, T=truncate, L=do nothing (default)"
SAY " priority: (-128 to +128) (default CRASH)"
SAY " or HOLD=-50, NORM=0, DIRECT=30, CRASH=50"
say BOLD" FLOCVT"OFF" - convert 4d ?LO/?UT files to XferQ"
say BOLD" CLEAN"OFF" - remove non-existing files from queue"
say
callusage:
if u_shelter~="UMBRELLA" then do
say BOLD" CALL"OFF" site (CRASH|NOPICKUP|phonenumber|line) (line)"
say " - start a site poll"
say " site=[domain#][z:][net/]node[.p]"
say " site=uu(sitename) | clock(n) | bbs/fax_(sitename)"
say BOLD" KILL"OFF" site - abort a site poll"
say BOLD" POLL"OFF" (priority) - poll all non-HOLD sites with pending mail"
say " priority = NORMAL, DIRECT, CRASH"
end;else do
say BOLD" CALL"OFF" site (number)"
say " - start a site poll"
say BOLD" KILL"OFF" site"
say " - abort a site poll"
say " site=[domain#][z:][net/]node[.p]"
end
exit 0
/**/
openpscr:
pscreen=ReadVar('SCREEN')
if upper(pscreen)="WORKBENCH SCREEN" then return
Interpret include('CFG:SCREEN.CFG')
if SCREENPREFS="" | SCREENPREFS="SCREENPREFS" then do
Say "Error reading CFG:SCREEN.CFG"
exit 20
end
parse var SCREENPREFS width','height','planes
colors=2**planes
parse var SCREENFONT font','fontsize
modes=translate(SCREENMODES," ",",")
globals=translate(SCREENGLOBALS," ",",")
if pos('AUTOCLOSE',globals)>0 & pos('WAIT',GetClip(sspec))=0 then do
Say "Error: cannot open a non-WAIT window on an AUTOCLOSE screen"
exit 20
end;else do
call SetClip("SSMAUTOCLOSE","TRUE")
end
cxx=translate(SCREENCX,' "',",'")
if index(modes,"L") ~=0 then textoverscan_height=TEXTOVERSCAN_HEIGHT*2
rgball=""
do i=0 to colors-1
if RGB.i="" then leave
rgball=rgball||d2x(word(RGB.i,1))||d2x(word(RGB.i,2))||d2x(word(RGB.i,3))||','
end
rgball=delstr(rgball,lastpos(',',rgball),1)
if width>640 then t_width=width-TEXTOVERSCAN_WIDTH
else t_width=0
if height>230 then t_height=height-TEXTOVERSCAN_HEIGHT
else t_height=0
if t_width~=0 | t_height~=0 then sz='SIZE=OSCAN_TXT:0,0,+'t_width',+'t_height' DISPCLIP=OSCAN_TEXT'
else sz='SIZE='width','height
if SCREENPEN="" | SCREENPENS="SCREENPENS" then opts= sz 'PLANES='planes 'COLORS='rgball 'MODE='modes 'FONT='font'.'fontsize globals cxx
else opts= sz 'PLANES='planes 'PENS='SCREENPENS 'COLORS='rgball 'MODE='modes 'FONT='font'.'fontsize globals cxx
cmd='ScreenManager OPEN "'pscreen'"' opts
Say 'Executing:'cmd
address COMMAND cmd
if RC~=0 then say "Could not open screen:" pscreen
else call setclip('SMMPSCREEN','TRUE')
return
closepscr:
if GetClip('SMMAUTOCLOSE')="TRUE" then return
pscreen=GetClip('SCREEN')
if upper(pscreen)="WORKBENCH SCREEN" then return
myscreen=GetClip('SMMPSCREEN')
if upper(myscreen)~="TRUE" then return
call SetClip('SMMPSCREEN',"")
call close('STDIN')
call close('STDOUT')
call delay(50)
address COMMAND 'ScreenManager CLOSE "'pscreen'"'
return
setup:
shelter=arg(1)
u_shelter=upper(shelter)
l_shelter=lower(shelter)
call SetClip('SHELTER',u_shelter)
if u_shelter="ROOF" then envpath=""
else envpath=shelter"/"
callscript="S:"||left(u_shelter,1)||"CALL"
file=l_shelter'file'
fwindow=l_shelter'win'
fgroup=l_shelter'wpl'
window=l_shelter'ss'
wgroup=l_shelter'wplstat'
mport=u_shelter
if (u_shelter="UMBRELLA" | u_shelter="GAZEBO") then do
wsrc.1=l_shelter'CFG.wpl'
wsrc.2=l_shelter'MODEM.wpl'
wsrc.3=l_shelter'.wpl'
wscount=3
end;else do
if ReadVar('MENUS')="FILE" then do
wsrc.1=l_shelter'CFG.wpl'
wsrc.2=l_shelter'MODEM.wpl'
wsrc.3=l_shelter'NOTIFY.wpl'
wsrc.4=l_shelter'.wpl'
wscount=4
end;else do
wsrc.1=l_shelter'CFG.wpl'
wsrc.2=l_shelter'MENUS.wpl'
wsrc.3=l_shelter'MODEM.wpl'
wsrc.4=l_shelter'NOTIFY.wpl'
wsrc.5=l_shelter'.wpl'
wscount=5
end
end
return
openwin:
wpos=GetClip('WPOS')
if wpos="" | wpos="WPOS" then wpos="0/80/600/40"
wspec=GetClip('WSPEC')
if wspec="" | wspec="WSPEC" then wspec="INACTIVE/AUTO/WAIT"
spos=GetClip('SPOS')
if spos="" | spos="SPOS" then spos="0/80/600/80"
sspec=GetClip('SSPEC')
if sspec="" | sspec="SSPEC" then sspec="INACTIVE/AUTO/WAIT"
if arg(1)="P" then win='CON:'spos'/'u_shelter' Mailer Manager v'smver' [Click to Close]/'sspec'/SCREEN'
else if arg(1)="S" then win='CON:'wpos'/'u_shelter' Mailer Manager v'smver'/'wspec'/SCREEN'
else return
call close('STDOUT')
pscreen=ReadVar('SCREEN')
call open('STDOUT',win||pscreen,'W')
call close('STDIN')
call open('STDIN','*','R')
havewin=1
return
isftn:
if datatype(arg1,"N") then return 1
if pos(arg(1),"#")>0 | pos(arg(1),":")>0 | pos(arg(1),"/")>0 then return 1
return 0